home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / lzhtv10.arc / INTRCOMM.INC < prev    next >
Text File  |  1989-04-21  |  13KB  |  491 lines

  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * intrcomm.inc - interrupt-based communication library for PCB ProDOOR
  15.  *
  16.  *)
  17.  
  18. {$R-,S-}
  19.  
  20.  
  21. (* ------------------------------------------------------------ *)
  22. (*
  23.  * Interrupt handler, install and uninstall
  24.  *
  25.  *)
  26.  
  27. procedure INTR_service_transmit;
  28.    (* low-level interrupt service for transmit, call only when transmit
  29.       holding register is empty *)
  30. var
  31.    c:       char;
  32. const
  33.    recur:  boolean = false;
  34.  
  35. begin
  36.  
  37. (* prevent recursion fb/bg *)
  38.    if recur then exit;
  39.    recur := true;
  40.  
  41. (* drop out if transmitter is busy *)
  42.    if (port[ port_base+LSR ] and LSR_THRE) = 0 then
  43.    begin
  44.       recur := false;
  45.       exit;
  46.    end;
  47.  
  48.    (* stop transmitting when queue is empty, or XOFF is active
  49.       or it is not CLEAR-to-send to modem *)
  50.  
  51.    xmit_active := (txque.count <> 0) and (not xoff_active) and
  52.                   (disable_CTS_check or ((port[port_base+MSR] and MSR_CTS)>0));
  53.  
  54. (*********
  55.    xmit_active :=
  56.       not ( (txque.count = 0)
  57.            or
  58.              XOFF_active
  59.            or
  60.             (
  61.                not disable_CTS_check)
  62.             and
  63.               ((port[ port_base+MSR ] and MSR_CTS) = 0)
  64.             )
  65.           );
  66. *********)
  67.  
  68.    (* start next byte transmitting *)
  69.    if xmit_active then
  70.    begin
  71.       c := txque.data[txque.next_out];
  72.       if txque.next_out < sizeof(txque.data) then
  73.          inc(txque.next_out)
  74.       else
  75.          txque.next_out := 1;
  76.       dec(txque.count);
  77.  
  78.       port[ port_base+THR ] := ord(c);
  79.    end;
  80.  
  81.    recur := false;
  82. end;
  83.  
  84.  
  85. (* ------------------------------------------------------------ *)
  86. procedure control_k;
  87.    (* process cancel-output command *)
  88. begin
  89.    txque.next_in := 1;
  90.    txque.next_out := 1;          (* throw away pending output *)
  91.    txque.count := 0;             
  92.  
  93.    linenum := 2000;              (* cancel current function *)
  94.    pending_keys[0] := chr(1);
  95.    pending_keys[1] := ^M;        (* fake <return> to break loose from prompts *)
  96. end;
  97.  
  98.  
  99. (* ------------------------------------------------------------ *)
  100. procedure INTR_service_receive;
  101.    (* low-level interrupt service for receive data,
  102.       call only when receive data is ready *)
  103. var
  104.    c:      char;
  105.  
  106. begin
  107.    if (port[ port_base+LSR ] and LSR_DAV) = 0 then
  108.       exit;
  109.  
  110.    c := chr( port[ port_base+RBR ] );
  111.  
  112.    if XOFF_active then           (* XOFF cancelled by any character *)
  113.       cancel_xoff
  114.    else
  115.  
  116.    if c = XOFF_char then         (* process XOFF/XON flow control *)
  117.       XOFF_active := true
  118.    else
  119.  
  120.    if (c = ^K) then              (* process cancel-output command *)
  121.       control_k
  122.    else
  123.  
  124.    if c = carrier_lost then      (* ignore this special character! *)
  125.    begin
  126.       {do nothing}
  127.    end
  128.    else
  129.  
  130.    if rxque.count < sizeof(rxque.data) then
  131.    begin
  132.       inc(rxque.count);
  133.       rxque.data[rxque.next_in] := c;
  134.       if rxque.next_in < sizeof(rxque.data) then
  135.          inc(rxque.next_in)
  136.       else
  137.          rxque.next_in := 1;
  138.    end;
  139. end;
  140.  
  141.  
  142. (* ------------------------------------------------------------ *)
  143. procedure INTR_poll_transmit;
  144.    (* recover from CTS or XOF handshake when needed *)
  145. begin
  146.    {no action if nothing to transmit}
  147.    if (txque.count = 0) or local then
  148.       exit;
  149.  
  150.    {check for XON if output suspended by XOFF}
  151.    INTR_service_receive;
  152.    INTR_service_transmit;
  153. (***************
  154.    if XOFF_active then
  155.       INTR_service_receive
  156.    else
  157.  
  158.    {restart the transmitter if it has lost an interrupt}
  159.    if ((port[ port_base+LSR ] and LSR_THRE) <> 0) or (not xmit_active)  then
  160.       INTR_service_transmit;
  161. ************)
  162. end;
  163.  
  164.  
  165. (* ------------------------------------------------------------ *)
  166. procedure cancel_xoff;
  167. begin
  168.    XOFF_active := false;
  169.    INTR_poll_transmit;
  170. end;
  171.  
  172.  
  173. (* ------------------------------------------------------------ *)
  174. procedure INTR_check_interrupts;
  175.    (* check for and process any pending 8250 interrupts.
  176.       can be called from TPAS *)
  177. var
  178.    status:  integer;
  179.  
  180. begin
  181.  
  182. (* get the interrupt identification register *)
  183.    status := port[ port_base+IIR ];
  184.  
  185. (* repeatedly service interrupts until no more services possible *)
  186.    while (status and IIR_PENDING) = 0 do
  187.    begin
  188.  
  189.       case (status and IIR_MASK) of
  190.          IIR_THRE:  (* transmit holding register empty interrupt *)
  191.             INTR_service_transmit;
  192.  
  193.          IIR_DAV:   (* data available interrupt *)
  194.             INTR_service_receive;
  195.       end;
  196.  
  197.    (* get the interrupt identification register again *)
  198.       status := port[ port_base+IIR ];
  199.    end;
  200.  
  201. end;
  202.  
  203.  
  204. (* ------------------------------------------------------------ *)
  205. procedure INTR_interrupt_handler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: word);
  206. interrupt;
  207.    (* low-level interrupt service routine.  this procedure processes
  208.       all receive-ready and transmit-ready interrupts from the 8250 chip.
  209.       DO NOT call this proc from TPAS *)
  210.  
  211. begin
  212.  
  213. (* service interrupts until no more services possible *)
  214.    INTR_check_interrupts;
  215.  
  216. (* acknowledge the interrupt and return to foreground operation *)
  217.    port[ $20 ] := $20;   {non-specific EOI}
  218.  
  219. end;
  220.  
  221.  
  222. (* ------------------------------------------------------------ *)
  223. function INTR_receive_ready: boolean;
  224.    (* see if any receive data is ready on the active com port *)
  225. begin
  226.    INTR_poll_transmit;
  227.    INTR_receive_ready := rxque.count > 0;
  228. end;
  229.  
  230.  
  231. (* ------------------------------------------------------------ *)
  232. procedure INTR_flush_com;
  233.    (* wait for all pending transmit data to be sent *)
  234. begin
  235.    enable_int;
  236.    while txque.count > 0 do
  237.    begin
  238.       INTR_poll_transmit;
  239.       give_up_time;             (* give up extra time *)
  240.    end;
  241. end;
  242.  
  243.  
  244. (* ------------------------------------------------------------ *)
  245. procedure verify_txque_space;
  246.    (* wait until there is enough space in the queue for this message *)
  247.    (* or until flow control is released *)
  248. begin
  249.    while txque.count > queue_low_water do
  250.    begin
  251.       INTR_poll_transmit;
  252.       give_up_time;             (* give up extra time *)
  253.    end;
  254. end;
  255.  
  256.  
  257. (* ------------------------------------------------------------ *)
  258. procedure INTR_lower_dtr;
  259.    (* lower DTR to inhibit modem answering *)
  260. begin
  261.    if local then exit;
  262.    port[ port_base+MCR ] := port [ port_base+MCR ] and not MCR_DTR;
  263. end;
  264.  
  265.  
  266. (* ------------------------------------------------------------ *)
  267. procedure INTR_raise_dtr;
  268.    (* raise DTR to allow modem answering - not supported by BIOS *)
  269. begin
  270.    if local then exit;
  271.    port[ port_base+MCR ] := port [ port_base+MCR ] or (MCR_DTR+MCR_RTS);
  272. end;
  273.  
  274.  
  275. (* ------------------------------------------------------------ *)
  276. procedure INTR_select_port(chan: integer);
  277.    (* lookup the port address for the specified com channel *)
  278. begin
  279.    com_current_chan := chan;
  280.    xmit_active := false;
  281.    XOFF_active := false;
  282.  
  283.    case chan of
  284.      -1,
  285.       0: begin
  286.             port_base := $3F8;
  287.             port_intr := $0C;
  288.             intr_mask := $10;
  289.          end;
  290.  
  291.       1: begin
  292.             port_base := $2F8;
  293.             port_intr := $0B;
  294.             intr_mask := $08;
  295.          end;
  296.  
  297.    {  (* add cases here for more COM ports *)
  298.       else
  299.          begin
  300.             writeln('Invalid COM channel: ',chan);
  301.             halt;
  302.          end;  }
  303.    end;
  304.  
  305. (**
  306. writeln('[chan=',chan,' port base=',port_base,' intr=',port_intr,' mask=',intr_mask,']');
  307. **)
  308.  
  309. (* initialize the receive and transmit queues *)
  310.    rxque.next_in := 1;
  311.    rxque.next_out := 1;
  312.    rxque.count := 0;
  313.  
  314.    txque.next_in := 1;
  315.    txque.next_out := 1;
  316.    txque.count := 0;
  317.  
  318.    INTR_raise_dtr;
  319. end;
  320.  
  321.  
  322. (* ------------------------------------------------------------ *)
  323. procedure INTR_init_com(chan: integer);
  324.    (* initialize communication handlers for operation with the specified
  325.       com port number.  must be called before any other services here *)
  326. begin
  327.  
  328. (* initialize port numbers, receive and transmit queues *)
  329.    INTR_select_port(chan);
  330.  
  331. (* save the old interrupt handler's vector *)
  332.    GetIntVec(port_intr, old_vector);
  333. {writeln('got old');}
  334.  
  335. (* install a vector to the new handler *)
  336.    SetIntVec(port_intr,@INTR_interrupt_handler);
  337. {writeln('new set');}
  338.  
  339. (* save original 8250 registers *)
  340.    disable_int;
  341.    prev_LCR := port[ port_base+LCR ];
  342.    prev_MCR := port[ port_base+MCR ];
  343.    prev_IER := port[ port_base+IER ];
  344.    prev_ICTL  := port[ ICTL ];
  345.  
  346. (* initialize the 8250 for interrupts *)
  347.    port[ port_base+LCR ] := port[ port_base+LCR ] and not LCR_NORMAL;
  348.    port[ port_base+MCR ] := port[ port_base+MCR ] or MCR_OUT2;
  349.    port[ port_base+IER ] := IER_DAV+IER_THRE;
  350.  
  351. (* enable the interrupt through the interrupt controller *)
  352.    port[ ICTL ] := port[ ICTL ] and not intr_mask;
  353.    enable_int;
  354.  
  355. (* initialize the receive queues in case of an initial garbage byte *)
  356.    disable_int;
  357.    rxque.next_in := 1;
  358.    rxque.next_out := 1;
  359.    rxque.count := 0;
  360.    enable_int;
  361.  
  362. {writeln('init done');}
  363.  
  364. end;
  365.  
  366.  
  367. (* ------------------------------------------------------------ *)
  368. procedure INTR_uninit_com;
  369.    (* remove interrupt handlers for the com port
  370.       must be called before exit to system *)
  371. begin
  372.    if (port_base = -1) or (old_vector = nil) then
  373.       exit;
  374.  
  375. (* wait for the pending data to flush from the queue *)
  376.    INTR_flush_com;
  377.  
  378. (* attach the old handler to the interrupt vector *)
  379.    disable_int;
  380.  
  381.    SetIntVec(port_intr, old_vector);
  382.  
  383.    port[ port_base+LCR ] := prev_LCR;
  384.    port[ port_base+MCR ] := prev_MCR;
  385.    port[ port_base+IER ] := prev_IER;
  386.    port[ ICTL ] := (port[ ICTL ] and not intr_mask) or (prev_ICTL and intr_mask);
  387.  
  388.    enable_int;
  389.  
  390. (***
  391. writeln('prev: LCR=',itoh(prev_LCR),
  392.              ' MCR=',itoh(prev_MCR),
  393.              ' IER=',itoh(prev_IER),
  394.              ' ICTL=',itoh(prev_ICTL));
  395. writeln(' now: LCR=',itoh(port[ port_base+LCR ]),
  396.              ' MCR=',itoh(port[ port_base+MCR ]),
  397.              ' IER=',itoh(port[ port_base+IER ]),
  398.              ' ICTL=',itoh(port[ ICTL ]));
  399. writeln('intr_mask=',itoh(intr_mask),
  400.              ' vector=',itoh(seg(old_vector)),':',itoh(ofs(old_vector)));
  401. ***)
  402.  
  403.    old_vector := nil;
  404. end;
  405.  
  406.  
  407.  
  408. (* ------------------------------------------------------------ *)
  409. function INTR_receive_data:  char;
  410.    (* wait for and return 1 character from the active com port *)
  411.    (* returns carrier_lost if carrier is not present *)
  412. var
  413.    c: char;
  414.  
  415. begin
  416.  
  417.    repeat
  418.       if INTR_receive_ready then
  419.       begin
  420.          disable_int;
  421.  
  422.          {deque from rxque}
  423.          c := rxque.data[rxque.next_out];
  424.          if rxque.next_out < sizeof(rxque.data) then
  425.             inc(rxque.next_out)
  426.          else
  427.             rxque.next_out := 1;
  428.          dec(rxque.count);
  429.  
  430.          enable_int;
  431.  
  432.          {strip parity in 7,E mode}
  433.          if even_parity then
  434.             c := chr( ord(c) and $7f );
  435.  
  436.          INTR_receive_data := c;
  437.          exit;
  438.       end;
  439.  
  440.       {give up time while waiting}
  441.       give_up_time;
  442.  
  443.    until not ((port[port_base+MSR] and MSR_RLSD)<>0);
  444.  
  445.    {carrier not present}
  446.    cancel_xoff;
  447.    INTR_receive_data := carrier_lost;
  448. end;
  449.  
  450.  
  451. (* ------------------------------------------------------------ *)
  452. procedure INTR_transmit_data(s:    longstring);
  453.    (* transmits a string of characters to the specified com port;
  454.       does not transmit when carrier is not present *)
  455. var
  456.    i:    integer;
  457.  
  458. begin
  459.  
  460. (* wait until there is enough space in the queue for this message *)
  461. (* or until flow control is released *)
  462.  
  463.    if txque.count > queue_high_water then
  464.       verify_txque_space;
  465.  
  466.  
  467. (* enque the string to be transmitted *)
  468.    for i := 1 to length(s) do
  469.    begin
  470.       disable_int;
  471.  
  472.       inc(txque.count);
  473.       txque.data[txque.next_in] := s[i];
  474.       if txque.next_in < sizeof(txque.data) then
  475.          inc(txque.next_in)
  476.       else
  477.          txque.next_in := 1;
  478.  
  479.       enable_int;
  480.    end;
  481.  
  482.  
  483. (* force an initial interrupt to get things rolling (in case there are
  484.    no more pending transmit-ready interrupts *)
  485.  
  486.    INTR_poll_transmit;
  487. end;
  488.  
  489. { $R+,S+}
  490.  
  491.